/* General declarations.

   This file is part of khipu.

   khipu is free software: you can redistribute it and/or modify
   it under the terms of the GNU Lesser General Public License as published by
   the Free Software Foundation; either version 3 of the License, or
   (at your option) any later version.

   This program is distributed in the hope that it will be useful,
   but WITHOUT ANY WARRANTY; without even the implied warranty of
   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   GNU Lesser General Public License for more details.

   You should have received a copy of the GNU Lesser General Public License
   along with this program.  If not, see <https://www.gnu.org/licenses/>.  */

#ifndef __KP_DEFS__
#define __KP_DEFS__   1

#include "config.hpp"
#include <stdint.h>
#include <cstddef>
#include <cerrno>
#include <cstring>

#if !defined (__GNUC__) && defined (KP_PLATFORM_WINDOWS)
  #include <malloc.h>
#endif

#define KP_DECLS_BEGIN   namespace khipu {
#define KP_DECLS_END     }

KP_DECLS_BEGIN

typedef uintptr_t object;

struct typecode
{
  enum
    {
      INT = 0,
      CHAR,
      // Immediate objects have a typecode <= this constant.
      // The cons typecode must appear right after.
      CONS,
      BIGINT,
      FLOAT,
      BIGFLOAT,
      BVECTOR,
      STR,
      ARRAY,
      TABLE,
      TUPLE,
      STREAM,
      SYMBOL,
      FCT,
      CORO,
      THREAD,
      PKG,
      INSTANCE,
      CUSTOM,
      LAST
    };
};

#define KP_NELEM(array)   (sizeof (array) / sizeof (array[0]))

union obj_cast_helper
{
  object obj;
  void *ptr;
};

#ifdef KP_ARCH_WIDE

/* On 64-bit platforms, we use 8 or 9 bits from the word 
 * in order to store some information (The type, sign, etc).
 * This limits our memory space a bit, but 2^55 bytes should
 * be more than enough for the working set of any program. */

union ptr_cast_helper
{
  const void *p;
  object obj;
};

const int TYPE_SHIFT = 57;
const object SIGN_BIT = UINT64_C (1) << (TYPE_SHIFT - 1);
const object EXTRA_BIT = SIGN_BIT >> 1;

inline constexpr int varobj_sign (object obj)
{
  return ((int)((obj >> (TYPE_SHIFT - 1))) & 1);
}

// Get a pointer from a varobj, masking sign bit and type.
inline constexpr void* unmask (object obj)
{
  return ((obj_cast_helper { obj & (EXTRA_BIT - 1) }).ptr);
}

inline constexpr object ptrtype (const void *p, int type)
{
  return ((((object)type) << TYPE_SHIFT) | ((ptr_cast_helper { p }).obj));
}

inline constexpr object ptrtype (object ptrval, int type)
{
  return ((((object)type) << TYPE_SHIFT) | ptrval);
}

inline constexpr int itype (object obj)
{
  return ((int)(obj >> TYPE_SHIFT));
}

inline constexpr bool immediate_p (object obj)
{
  return (itype (obj) <= typecode::CHAR);
}

const object UNBOUND = UINT64_C (0x7f) << TYPE_SHIFT;

extern void* ensure_mask_impl (void *ptr, int mask = TYPE_SHIFT);

#else

/* On the other hand, for 32-bit platforms, we can store much less
 * information on the word. We require pointers to be aligned to
 * 8 bytes, and use the least 3 significant bits for similar 
 * purposes as described above. */

const object EXTRA_BIT = 4;
const int TYPE_SHIFT = 0;

// Get a pointer from a varobj, masking type and extra bits.
inline constexpr void* unmask (object obj)
{
  return ((obj_cast_helper { obj & ~7 }).ptr);
}

inline constexpr void* ensure_mask_impl (void *p, int = TYPE_SHIFT)
{
  return (p);
}

// Immediate objects have typecodes 0 and 1 encoded in the first bits.
inline constexpr bool immediate_p (object obj)
{
  return ((obj & 3) < 2);
}

/* UNBOUND has the typecode of a 'char', but its representation is beyond
 * what can be encoded in unicode. This was chosen so that it's not a
 * varobj, nor a cons, thus making the TYPE_p predicates fast. */
const object UNBOUND = 0x80000001;

#endif

static_assert ((UNBOUND & EXTRA_BIT) == 0,
               "#<unbound> must not have the extra bit set");

template <typename T>
T* ensure_mask (T *ptr, int mask = TYPE_SHIFT)
{
  return ((T *)ensure_mask_impl (ptr, mask));
}

// Basic double-linked list, used quite frequently.
struct dlist
{
  dlist *next;
  dlist *prev;

  void init_head ()
    {
      this->next = this->prev = this;
    }

  void init_unlinked ()
    {
      this->next = this->prev = nullptr;
    }

  void add (dlist *newp)
    {
      newp->next = this->next;
      newp->prev = this;
      this->next->prev = newp;
      this->next = newp;
    }

  void del ()
    {
      this->next->prev = this->prev;
      this->prev->next = this->next;
    }

  bool linked_p () const
    {
      return (this->next != nullptr);
    }

  struct iter_base
    {
      dlist *runp;
      dlist *endp;

      iter_base (dlist *listp) : runp (listp->next), endp (listp)
        {
        }

      bool valid () const
        {
          return (this->runp != this->endp);
        }

      void _Adv ()
        {
          this->runp = this->runp->next;
        }

      dlist*& link ()
        {
          return (this->runp);
        }

      const dlist* link () const
        {
          return (this->runp);
        }
    };

  template <typename T>
  struct iter_type : iter_base
    {
      ptrdiff_t off;

      iter_type (dlist *listp, ptrdiff_t offset) :
          iter_base (listp), off (offset)
        {
        }

      T& operator* ()
        {
          return (*(T *)((char *)this->runp - this->off));
        }

      const T& operator* () const
        {
          return (*(const T *)((const char *)this->runp - this->off));
        }

      T* operator-> ()
        {
          return (&**this);
        }

      const T* operator-> () const
        {
          return (&**this);
        }

      iter_type<T>& operator++ ()
        {
          this->_Adv ();
          return (*this);
        }

      iter_type<T> operator++ (int)
        {
          iter_type<T> ret = *this;
          this->_Adv ();
          return (ret);
        }
    };

  template <typename T>
  iter_type<T> iterator (dlist T::*mem)
    {
      return (iter_type<T> (this,
        (char *)&((T *)nullptr->*mem) - (char *)nullptr));
    }
};

// Base type for non-immediate, non-cons types.
struct alignas (8) varobj
{
  dlist gc_link;
  union
    {
      struct
         {
#ifdef KP_LITTLE_ENDIAN
           uint32_t vo_flags:24;
           uint32_t vo_type:8;
#  ifdef KP_ARCH_WIDE
           uint32_t vo_size;
#  endif
#else
#  ifdef KP_ARCH_WIDE
           uint32_t vo_size;
#  endif
           uint32_t vo_type:8;
           uint32_t vo_flags:24;
#endif
         };
      uintptr_t vo_full;
    };

#ifndef KP_ARCH_WIDE
  uint32_t vo_size;
#endif

  void init_vo ()
    {
      this->gc_link.init_unlinked ();
    }

  object as_obj () const
    {
#ifdef KP_ARCH_WIDE
      return (ptrtype (this, this->vo_type));
#else
      return ((object)this | 3);
#endif
    }

  bool flagged_p (uint32_t flg) const
    {
      return ((this->vo_full & flg) != 0);
    }

  bool local_p () const
    {
      return (!this->gc_link.linked_p ());
    }

  // Atomically manipulate the flags of a varobj.
  bool set_flag (uint32_t flg);
  bool clr_flag (uint32_t flg);
  bool cas_flag (uint32_t mask, uint32_t set);
};

// Flags that apply to every object.
enum
{
  FLAGS_GCBIT1      = 1 << 0,
  FLAGS_GCBIT2      = 1 << 1,
  FLAGS_GCWIP       = 1 << 2,
  FLAGS_FINALIZABLE = 1 << 3,
  FLAGS_CONST       = 1 << 4,
  FLAGS_ATEXIT      = 1 << 5,
  FLAGS_GCDIRTY     = 1 << 6
};

// Flags for the 'nzap' interface.
enum
{
  NZAP_NOMT = 1 << 0,
  NZAP_DFL  = 1 << 1,
  NZAP_PREV = 1 << 2
};

inline varobj* as_varobj (object obj)
{
  return ((varobj *)unmask (obj));
}

// Finalizable objects.
struct finobj : public varobj
{
  void (*fini) (finobj *);
};

inline finobj* as_finobj (object obj)
{
  return ((finobj *)unmask (obj));
}

#ifdef KP_ARCH_WIDE

inline constexpr bool varobj_p (object obj)
{
  return (itype (obj) > typecode::CONS);
}

#else

inline constexpr bool varobj_p (object obj)
{
  return ((obj & 3) == 3);
}

#endif

// Wrapper for local (stack-allocated) varobjs.
template <typename T>
struct local_varobj : public T
{
  local_varobj ()
    {
      this->vo_full = 0;
      this->vo_type = T::code;
      this->init_vo ();
    }
};

// A very common and useful constant.
KP_EXPORT const object NIL;

inline bool nil_p (object obj)
{
  return (obj == NIL);
}

// Common definitions, because why not?
template <typename T>
inline T (min) (const T& left, const T& right)
{
  return (right < left ? right : left);
}

template <typename T>
inline T (max) (const T& left, const T& right)
{
  return (left > right ? left : right);
}

template <typename T>
inline T (abs) (T val)
{
  return (val < 0 ? -val : val);
}

template <typename T>
void (swap) (T& left, T& right)
{
  T tmp = left;
  left = right, right = tmp;
}

template <typename T>
inline constexpr bool pow2_p (T val)
{
  return (val != 0 && ((val & (val - 1)) == 0));
}

template <typename T>
void destroy (T *ptr)
{
  ptr->~T ();
}

// Stack allocations.
#define KP_HAS_ALLOCA   1

#ifdef __GNUC__
#  define KP_ALLOCA   __builtin_alloca
#elif defined (KP_PLATFORM_WINDOWS)
#  define KP_ALLOCA   _alloca
#elif defined (KP_PLATFORM_AIX)
  #pragma alloca
#  define KP_ALLOCA   alloca
#else
#  undef KP_HAS_ALLOCA
#endif

inline constexpr uint32_t
hash_rotl (uint32_t code, uint32_t nb)
{
  return ((code << nb) | (code >> (32 - nb)));
}

inline constexpr uint32_t
mix_hash (uint32_t h1, uint32_t h2)
{
  return (hash_rotl (h1, 5) ^ h2);
}

// Like 'memcpy' and 'memmove' for objects.
inline object*
copy_objs (object *dst, const object *src, size_t nobjs)
{
  return ((object *)memcpy (dst, src, nobjs * sizeof (object)) + nobjs);
}

inline void
move_objs (object *dst, const object *src, size_t nobjs)
{
  memmove (dst, src, nobjs * sizeof (object));
}

// Misc. definitions.
#define KP_CONCAT_(x, y)   x ## y
#define KP_CONCAT(x, y)    KP_CONCAT_(x, y)

#ifndef __GNUC__
#  define __attribute__(expr)
#endif

// Necessary assertion for stack-allocated types.
static_assert (alignof (varobj) % 8 == 0, "invalid alignment for varobjs");

// Utility functions.
#ifndef KP_ARCH_WIDE

inline int
itype (object obj)
{
  auto tmp = obj & 3;
  switch (tmp)
    {
      case 0: case 2:
        return (tmp);
      case 1:
        return (obj == UNBOUND ? 0x7f : tmp);
      default:
        return (as_varobj(obj)->vo_type);
    }
}

#endif

KP_EXPORT uint32_t upsize (uint32_t n);

#ifdef __GNUC__
#  define kp_expect(cond, val)   __builtin_expect (!!(cond), (val))
#else
#  define kp_expect(cond, val)   (cond)
#endif

#define kp_likely(cond)     kp_expect (cond, 1)
#define kp_unlikely(cond)   kp_expect (cond, 0)

#ifdef __GNUC__

inline constexpr int ctz (uint32_t val)
{
  return (__builtin_ctz (val));
}

#else

inline int ctz (uint32_t val)
{
  int ret = 0;

  val &= ~val + 1;   // Isolate the LSB.
  ret += !!(val & 0xaaaaaaaau) << 0;
  ret += !!(val & 0xccccccccu) << 1;
  ret += !!(val & 0xf0f0f0f0u) << 2;
  ret += !!(val & 0xff00ff00u) << 3;
  ret += !!(val & 0xffff0000u) << 4;

  return (ret);
}

#endif

inline uint16_t
get16 (const void *ptr)
{
  uint16_t ret;
  memcpy (&ret, ptr, sizeof (ret));
  return (ret);
}

inline uint32_t
get32 (const void *ptr)
{
  uint32_t ret;
  memcpy (&ret, ptr, sizeof (ret));
  return (ret);
}

inline void
put16 (void *ptr, uint32_t val)
{
  uint16_t v2 = (uint16_t)val;
  memcpy (ptr, &v2, sizeof (v2));
}

inline void
put32 (void *ptr, uint32_t val)
{
  memcpy (ptr, &val, sizeof (val));
}

// Return value for builtins - Assumes 'interp' is bound.
#define kp_return(val)   return (interp->retval = (val))

// Useful forward declarations.
struct stream;
struct io_info;
struct pack_info;
struct comparator;

// Definitions for error handling.

/* Much like other projects, we are not going to use standard C++ exceptions
 * for khipu. The primary reason is that exceptions, as implemented in the
 * most popular library (libgcc) are fundamentally unsafe in multi-threaded
 * contexts. Additional reasons include binary bloat and performance hits
 * when exceptions are thrown.
 *
 * The approach used by khipu is to use result types to denote success or
 * failure. Result types will be space-optimized so that the ABI can return
 * them in a single register for common cases. To perform exception handling,
 * one may do so manually, by examining the result type, or with the helper
 * macros, KP_TRY and KP_VTRY.
 *
 * The macro KP_VTRY receives 1 or more expressions, and evaluates them in
 * order. If any of them is an error, it returns immediately.
 *
 * The KP_TRY macro, in contrast, takes a single expression. If it's an error,
 * it returns immediately as well, but if not, it returns the wrapped value
 * of that expression.
 *
 * Because of limitations with the C++ processor, the KP_TRY macro may expand
 * to multiple expressions. As such, care must be taken when using it.
 * For example, the following usage is invalid:
 *
 * if (condition)
 *   value = KP_TRY (expression);
 *
 * instead, second line must be wrapped in braces:
 *
 * if (condition)
 *   { value = KP_TRY (expression); } 
 *
 * Note that both macros can only be used inside functions that return result
 * types; anything else will generate compiler errors. */

struct [[nodiscard]] exception
{
};

template <typename T>
struct [[nodiscard]] result
{
  T value;
  bool error;

  result (const exception&) : error (true)
    {
    }

  result (const T& val = T ()) : value (val), error (false)
    {
    }

  template <typename T2>
  result (const result<T2>& rx) : value (*rx), error (rx.error_p ())
    {
    }

  T operator* () const
    {
      return (this->value);
    }

  bool error_p () const
    {
      return (this->error);
    }
};

template <typename T>
struct [[nodiscard]] result<T *>
{
  T *value;

  result (const exception&) : value (nullptr)
    {
    }

  result (T *ptr = nullptr) : value (ptr)
    {
    }

  T* operator* () const
    {
      return ((T *)this->value);
    }

  bool error_p () const
    {
      return (this->value == nullptr);
    }
};

template <>
struct [[nodiscard]] result<object>
{
  object value;
  static const object ERROR = ~(object)0;

  result (const exception&) : value (ERROR)
    {
    }

  result (object val = 0) : value (val)
    {
    }

  object operator* () const
    {
      return (this->value);
    }

  bool error_p () const
    {
      return (this->value == ERROR);
    }
};

template <>
struct [[nodiscard]] result<void>
{
  bool error;

  result (const exception&) : error (true)
    {
    }

  result (int) : error (false)
    {
    }

  int operator* () const
    {
      return (0);
    }

  bool error_p () const
    {
      return (this->error);
    }
};

template <typename T>
T deref (T x)
{
  return (x);
}

template <typename T>
T deref (const result<T>& rx)
{
  return (*rx);
}

inline int deref (const result<void>&)
{
  return (0);
}

template <typename T>
bool error_p (T)
{
  return (false);
}

template <typename T>
bool error_p (const result<T>& x)
{
  return (x.error_p ());
}

#define KP_CALL_NARGS_IMPL(A, B, C, D, E, F, G, H, I, J, K, L, _N, ...) _N

#define KP_CALL_NARGS(...)   \
  KP_CALL_NARGS_IMPL (__VA_ARGS__, 9, 8, 7, 6, 5, 4, 3, 2, 1, 0, )

#define KP_CALL_DISP(C, ...)   \
  KP_CONCAT (C, KP_CALL_NARGS (__VA_ARGS__)) (__VA_ARGS__)

#if defined (__GNUC__)
#  define KP_TRY_IP(Interp, Expr)   \
     ({   \
        auto __Tmp = (Expr);   \
        if (error_p (__Tmp))   \
          return (exception ());   \
        deref (__Tmp);   \
      })

#else
#  define KP_TRY_IP(Interp, Expr)   \
     deref ((Interp)->store_result (Expr));   \
     if ((Interp)->result_errored)   \
       return (exception ());   \
     else (void)0

#endif

#define KP_VTRY_TST0(_I, _F, E1)   \
  (error_p (E1))

#define KP_VTRY_TST1(_I, _F, E1, E2)   \
  (error_p (E1) || error_p (E2))

#define KP_VTRY_TST2(_I, _F, E1, E2, E3)   \
  (error_p (E1) || error_p (E2) || error_p (E3))

#define KP_VTRY_TST3(_I, _F, E1, E2, E3, E4)   \
  (error_p (E1) || error_p (E2) || error_p (E3) || error_p (E4))

#define KP_VTRY_TST4(_I, _F, E1, E2, E3, E4, E5)   \
  (error_p (E1) || error_p (E2) || error_p (E3) || error_p (E4) ||   \
   error_p (E5))

#define KP_VTRY_TST5(_I, _F, E1, E2, E3, E4, E5, E6)   \
  (error_p (E1) || error_p (E2) || error_p (E3) || error_p (E4) ||   \
   error_p (E5) || error_p (E6))

#define KP_VTRY_TST6(_I, _F, E1, E2, E3, E4, E5, E6, E7)   \
  (error_p (E1) || error_p (E2) || error_p (E3) || error_p (E4) ||   \
   error_p (E5) || error_p (E6) || error_p (E7))

#define KP_VTRY_TST7(_I, _F, E1, E2, E3, E4, E5, E6, E7, E8)   \
  (error_p (E1) || error_p (E2) || error_p (E3) || error_p (E4) ||   \
   error_p (E5) || error_p (E6) || error_p (E7) || error_p (E8))

#define KP_VTRY_IMPL(...)   \
  do   \
    {   \
      if (KP_CALL_DISP (KP_VTRY_TST, __VA_ARGS__))   \
        return (exception ());   \
    }   \
  while (false)

#define KP_VTRY(...)   KP_VTRY_IMPL (0, 0, ##__VA_ARGS__)

// Assumes that 'interp' is bound.
#define KP_TRY(Expr)             KP_TRY_IP (interp, Expr)

KP_DECLS_END

#endif
